home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / CHECKITM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  11.4 KB  |  435 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12.  
  13. unit CheckItm;
  14.  
  15. interface
  16.  
  17. {$I RX.INC}
  18.  
  19. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} Messages,
  20.   SysUtils, Classes, Controls, Forms, Menus, Graphics, StdCtrls, Placemnt,
  21.   Dialogs, RXCtrls, ExtCtrls, RTLConsts, DesignIntf, DesignEditors, VCLEditors;
  22.  
  23. type
  24.  
  25. { TCheckItemEditor }
  26.  
  27.   TCheckItemEditor = class(TForm)
  28.   private
  29.     FEdit: TEdit;
  30.     FOkBtn: TButton;
  31.     FCancelBtn: TButton;
  32.     FComboBox: TComboBox;
  33.     FEnableBox: TCheckBox;
  34.   public
  35.     constructor Create(AOwner: TComponent); override;
  36.   end;
  37.  
  38. { TCheckItemsEditor }
  39.  
  40.   TCheckItemsEditor = class(TForm)
  41.     Panel2: TPanel;
  42.     DeleteBtn: TButton;
  43.     NewBtn: TButton;
  44.     EditBtn: TButton;
  45.     Panel3: TPanel;
  46.     CancelBtn: TButton;
  47.     Panel1: TPanel;
  48.     FormPlacement: TFormPlacement;
  49.     OkBtn: TButton;
  50.     Popup: TPopupMenu;
  51.     AddListBtn: TButton;
  52.     cbGrayedItem: TMenuItem;
  53.     cbCheckedItem: TMenuItem;
  54.     cbUncheckedItem: TMenuItem;
  55.     N2: TMenuItem;
  56.     EnabledItem: TMenuItem;
  57.     ClearBtn: TButton;
  58.     CheckList: TRxCheckListBox;
  59.     UpBtn: TButton;
  60.     DownBtn: TButton;
  61.     procedure EditBtnClick(Sender: TObject);
  62.     procedure NewBtnClick(Sender: TObject);
  63.     procedure DeleteBtnClick(Sender: TObject);
  64.     procedure FormShow(Sender: TObject);
  65.     procedure FormCreate(Sender: TObject);
  66.     procedure EnabledItemClick(Sender: TObject);
  67.     procedure PopupPopup(Sender: TObject);
  68.     procedure AddListBtnClick(Sender: TObject);
  69.     procedure cbGrayedItemClick(Sender: TObject);
  70.     procedure cbCheckedItemClick(Sender: TObject);
  71.     procedure cbUncheckedItemClick(Sender: TObject);
  72.     procedure ClearBtnClick(Sender: TObject);
  73.     procedure CheckListClick(Sender: TObject);
  74.     procedure UpDownBtnClick(Sender: TObject);
  75.     procedure CheckListKeyDown(Sender: TObject; var Key: Word;
  76.       Shift: TShiftState);
  77.     procedure CheckListDragDrop(Sender, Source: TObject; X, Y: Integer);
  78.     procedure CheckListDragOver(Sender, Source: TObject; X, Y: Integer;
  79.       State: TDragState; var Accept: Boolean);
  80.   private
  81.     procedure CheckButtons;
  82.   end;
  83.  
  84. { CheckItems property editor }
  85.  
  86.   TCheckItemsProperty = class(TClassProperty)
  87.   public
  88.     function GetAttributes: TPropertyAttributes; override;
  89.     procedure Edit; override;
  90.   end;
  91.  
  92. implementation
  93.  
  94. {$R *.DFM}
  95.  
  96. {$IFDEF WIN32}
  97.  {$D-}
  98. {$ENDIF}
  99.  
  100. uses {$IFDEF RX_D3} StrLEdit, {$ELSE} StrEdit, {$ENDIF} Consts, RxConst,
  101.   VclUtils, BoxProcs;
  102.  
  103. { TCheckItemsProperty }
  104.  
  105. function TCheckItemsProperty.GetAttributes: TPropertyAttributes;
  106. begin
  107.   Result := [paDialog, paReadOnly];
  108. end;
  109.  
  110. procedure TCheckItemsProperty.Edit;
  111. var
  112.   Comp: TPersistent;
  113. begin
  114.   with TCheckItemsEditor.Create(Application) do
  115.   try
  116.     Comp := Self.GetComponent(0);
  117.     if Comp is TComponent then
  118.       Caption := TComponent(Comp).Name + '.' + Self.GetName
  119.     else Caption := Self.GetName;
  120.     if Comp is TRxCheckListBox then begin
  121.       CheckList.AllowGrayed := TRxCheckListBox(Comp).AllowGrayed;
  122.       CheckList.Sorted := TRxCheckListBox(Comp).Sorted;
  123.       CheckList.CheckKind := TrxCheckListBox(Comp).CheckKind;
  124.     end;
  125.     CheckList.Items := TStrings(GetOrdValue);
  126.     if ShowModal = mrOk then SetOrdValue(LongInt(CheckList.Items));
  127.   finally
  128.     Free;
  129.   end;
  130. end;
  131.  
  132. { TCheckItemEditor }
  133.  
  134. constructor TCheckItemEditor.Create(AOwner: TComponent);
  135. begin
  136. {$IFDEF CBUILDER}
  137.   inherited CreateNew(AOwner, 0);
  138. {$ELSE}
  139.   inherited CreateNew(AOwner);
  140. {$ENDIF}
  141.   { Form definitions }
  142.   {Left := 354;
  143.   Top := 338;}
  144.   BorderStyle := bsDialog;
  145.   Caption := 'Item editor';
  146.   ClientHeight := 92;
  147.   ClientWidth := 330;
  148.   Font.Color := clWindowText;
  149.   Font.Size := 8;
  150.   Font.Name := 'MS Sans Serif';
  151.   Font.Style := [];
  152.   Scaled := True;
  153.   Position := poScreenCenter;
  154.   { FEdit }
  155.   FEdit := TEdit.Create(Self);
  156.   with FEdit do begin
  157.     Parent := Self;
  158.     Left := 8;
  159.     Top := 12;
  160.     Width := 313;
  161.     Height := 21;
  162.     TabOrder := 0;
  163.   end;
  164.   { FOkBtn }
  165.   FOkBtn := TButton.Create(Self);
  166.   with FOkBtn do begin
  167.     Parent := Self;
  168.     Left := 168;
  169.     Top := 60;
  170.     Width := 75;
  171.     Height := 25;
  172.     Caption := ResStr(SOKButton);
  173.     Default := True;
  174.     ModalResult := mrOk;
  175.     TabOrder := 1;
  176.   end;
  177.   { FCancelBtn }
  178.   FCancelBtn := TButton.Create(Self);
  179.   with FCancelBtn do begin
  180.     Parent := Self;
  181.     Left := 246;
  182.     Top := 60;
  183.     Width := 75;
  184.     Height := 25;
  185.     Cancel := True;
  186.     Caption := ResStr(SCancelButton);
  187.     ModalResult := mrCancel;
  188.     TabOrder := 2;
  189.   end;
  190.   { FCheckBox }
  191.   FComboBox := TComboBox.Create(Self);
  192.   with FComboBox do begin
  193.     Parent := Self;
  194.     Style := csDropDownList;
  195.     Items.Add('Unchecked');
  196.     Items.Add('Checked');
  197.     Items.Add('Grayed');
  198.     Left := 8;
  199.     Top := 38;
  200.     Width := 88;
  201.     TabOrder := 3;
  202.   end;
  203.   { FEnableBox }
  204.   FEnableBox := TCheckBox.Create(Self);
  205.   with FEnableBox do begin
  206.     Parent := Self;
  207.     Left := 104;
  208.     Top := 40;
  209.     Width := 70;
  210.     Height := 17;
  211.     Caption := 'Enabled';
  212.     State := cbChecked;
  213.     TabOrder := 4;
  214.   end;
  215. end;
  216.  
  217. { TCheckItemsEditor }
  218.  
  219. procedure TCheckItemsEditor.FormCreate(Sender: TObject);
  220. begin
  221. {$IFDEF WIN32}
  222.   with FormPlacement do begin
  223.     UseRegistry := True;
  224.     IniFileName := SDelphiKey;
  225.   end;
  226. {$ENDIF}
  227. end;
  228.  
  229. procedure TCheckItemsEditor.CheckButtons;
  230. begin
  231.   DeleteBtn.Enabled := CheckList.ItemIndex >= 0;
  232.   EditBtn.Enabled := DeleteBtn.Enabled;
  233.   UpBtn.Enabled := CheckList.ItemIndex > 0;
  234.   DownBtn.Enabled := (CheckList.ItemIndex < CheckList.Items.Count - 1)
  235.     and (CheckList.ItemIndex >= 0);
  236. end;
  237.  
  238. procedure TCheckItemsEditor.EditBtnClick(Sender: TObject);
  239. var
  240.   I: Integer;
  241. begin
  242.   I := CheckList.ItemIndex;
  243.   if I >= 0 then
  244.     with TCheckItemEditor.Create(Application) do
  245.     try
  246.       if Screen.PixelsPerInch <> 96 then begin { scale to screen res }
  247.         ScaleBy(Screen.PixelsPerInch, 96);
  248.         { The ScaleBy method does not scale the font well, so set the
  249.           font back to the original info. }
  250.         Font.Name := 'MS Sans Serif';
  251.         Font.Size := 8;
  252.         Left := (Screen.Width div 2) - (Width div 2);
  253.         Top := (Screen.Height div 2) - (Height div 2);
  254.       end;
  255.       FEdit.Text := CheckList.Items[I];
  256.       FComboBox.ItemIndex := Integer(CheckList.State[I]);
  257.       FEnableBox.Checked := CheckList.EnabledItem[I];
  258.       if ShowModal = mrOk then begin
  259.         CheckList.Items[I] := FEdit.Text;
  260.         CheckList.State[I] := TCheckBoxState(FComboBox.ItemIndex);
  261.         CheckList.EnabledItem[I] := FEnableBox.Checked;
  262.       end;
  263.       Self.CheckList.ItemIndex := I;
  264.     finally
  265.       Free;
  266.     end;
  267. end;
  268.  
  269. procedure TCheckItemsEditor.NewBtnClick(Sender: TObject);
  270. var
  271.   Index: Integer;
  272. begin
  273.   with TCheckItemEditor.Create(Application) do
  274.   try
  275.     FEdit.Text := '';
  276.     FComboBox.ItemIndex := Integer(clbDefaultState);
  277.     FEnableBox.Checked := clbDefaultEnabled;
  278.     if ShowModal = mrOk then begin
  279.       Index := CheckList.Items.Add(FEdit.Text);
  280.       CheckList.State[Index] := TCheckBoxState(FComboBox.ItemIndex);
  281.       CheckList.EnabledItem[Index] := FEnableBox.Checked;
  282.       CheckButtons;
  283.     end;
  284.   finally
  285.     Free;
  286.   end;
  287. end;
  288.  
  289. procedure TCheckItemsEditor.DeleteBtnClick(Sender: TObject);
  290. begin
  291.   if CheckList.ItemIndex >= 0 then begin
  292.     CheckList.Items.Delete(CheckList.ItemIndex);
  293.     CheckButtons;
  294.   end;
  295. end;
  296.  
  297. procedure TCheckItemsEditor.FormShow(Sender: TObject);
  298. begin
  299.   CheckButtons;
  300. end;
  301.  
  302. procedure TCheckItemsEditor.EnabledItemClick(Sender: TObject);
  303. begin
  304.   CheckList.EnabledItem[CheckList.ItemIndex] :=
  305.     not CheckList.EnabledItem[CheckList.ItemIndex];
  306. end;
  307.  
  308. procedure TCheckItemsEditor.PopupPopup(Sender: TObject);
  309. var
  310.   Enable: Boolean;
  311. begin
  312.   Enable := CheckList.ItemIndex >= 0;
  313.   EnabledItem.Enabled := Enable;
  314.   cbGrayedItem.Enabled := Enable;
  315.   cbCheckedItem.Enabled := Enable;
  316.   cbUncheckedItem.Enabled := Enable;
  317.   cbGrayedItem.Checked := False;
  318.   cbCheckedItem.Checked := False;
  319.   cbUncheckedItem.Checked := False;
  320.   if Enable then begin
  321.     EnabledItem.Checked := CheckList.EnabledItem[CheckList.ItemIndex];
  322.     case CheckList.State[CheckList.ItemIndex] of
  323.       cbChecked: cbCheckedItem.Checked := True;
  324.       cbUnchecked: cbUncheckedItem.Checked := True;
  325.       cbGrayed: cbGrayedItem.Checked := True;
  326.     end;
  327.   end;
  328. end;
  329.  
  330. procedure TCheckItemsEditor.AddListBtnClick(Sender: TObject);
  331. var
  332.   I: LongInt;
  333. begin
  334.   with TStrEditDlg.Create(Application) do
  335.     try
  336. {$IFDEF WIN32}
  337. {$IFNDEF RX_D3}
  338.       CodeWndBtn.Visible := False;
  339. {$ENDIF}
  340. {$ENDIF}
  341.       if ShowModal = mrOk then begin
  342.         for I := 0 to Memo.Lines.Count - 1 do
  343.           if Memo.Lines[I] <> '' then
  344.             CheckList.Items.Add(Memo.Lines[I]);
  345.         CheckButtons;
  346.       end;
  347.     finally
  348.       Free;
  349.     end;
  350. end;
  351.  
  352. procedure TCheckItemsEditor.cbGrayedItemClick(Sender: TObject);
  353. begin
  354.   CheckList.State[CheckList.ItemIndex] := cbGrayed;
  355. end;
  356.  
  357. procedure TCheckItemsEditor.cbCheckedItemClick(Sender: TObject);
  358. begin
  359.   CheckList.State[CheckList.ItemIndex] := cbChecked;
  360. end;
  361.  
  362. procedure TCheckItemsEditor.cbUncheckedItemClick(Sender: TObject);
  363. begin
  364.   CheckList.State[CheckList.ItemIndex] := cbUnchecked;
  365. end;
  366.  
  367. procedure TCheckItemsEditor.ClearBtnClick(Sender: TObject);
  368. begin
  369.   CheckList.Clear;
  370. end;
  371.  
  372. procedure TCheckItemsEditor.CheckListClick(Sender: TObject);
  373. begin
  374.   CheckButtons;
  375. end;
  376.  
  377. procedure TCheckItemsEditor.UpDownBtnClick(Sender: TObject);
  378. var
  379.   OldIndex, NewIndex: Integer;
  380. begin
  381.   OldIndex := CheckList.ItemIndex;
  382.   if Sender = UpBtn then NewIndex := OldIndex - 1
  383.   else {if Sender = DownBtn then} NewIndex := OldIndex + 1;
  384.   CheckList.Items.Move(OldIndex, NewIndex);
  385.   CheckList.ItemIndex := NewIndex;
  386.   CheckButtons;
  387. end;
  388.  
  389. procedure TCheckItemsEditor.CheckListKeyDown(Sender: TObject;
  390.   var Key: Word; Shift: TShiftState);
  391. var
  392.   Incr: Integer;
  393. begin
  394.   case Key of
  395.     VK_DELETE:
  396.       if ssCtrl in Shift then begin
  397.         DeleteBtnClick(nil);
  398.         Key := 0;
  399.       end;
  400.     VK_INSERT:
  401.       if Shift = [] then begin
  402.         AddListBtnClick(nil);
  403.         Key := 0;
  404.       end;
  405.     VK_DOWN, VK_UP:
  406.       if (ssCtrl in Shift) then begin
  407.         if Key = VK_DOWN then Incr := 1
  408.         else Incr := -1;
  409.         BoxMoveFocusedItem(CheckList, CheckList.ItemIndex + Incr);
  410.         CheckButtons;
  411.         Key := 0;
  412.       end;
  413.   end;
  414. end;
  415.  
  416. procedure TCheckItemsEditor.CheckListDragDrop(Sender, Source: TObject; X,
  417.   Y: Integer);
  418. begin
  419.   if Source = CheckList then begin
  420.     BoxMoveFocusedItem(CheckList, CheckList.ItemAtPos(Point(X, Y), True));
  421.     CheckButtons;
  422.   end;
  423. end;
  424.  
  425. procedure TCheckItemsEditor.CheckListDragOver(Sender, Source: TObject; X,
  426.   Y: Integer; State: TDragState; var Accept: Boolean);
  427. begin
  428.   BoxDragOver(CheckList, Source, X, Y, State, Accept, CheckList.Sorted);
  429.   if State = dsDragLeave then CheckList.DragCursor := crDrag
  430.   else if (State = dsDragEnter) and (CheckList.SelCount > 1) then
  431.     CheckList.DragCursor := crMultiDrag;
  432. end;
  433.  
  434. end.
  435.